Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/dlaydr/dlaymain.frm

Visual Basic Form | 1995-05-08 | 5.7 KB | 174 lines

VERSION 2.00
Begin Form MainForm
   BackColor       =   &H00E0E0E0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Delayed Drag Demo"
   ClientHeight    =   2490
   ClientLeft      =   1845
   ClientTop       =   2085
   ClientWidth     =   3990
   ControlBox      =   0   'False
   Height          =   2895
   Icon            =   DLAYMAIN.FRX:0000
   Left            =   1785
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2490
   ScaleWidth      =   3990
   Top             =   1740
   Width           =   4110
   Begin CommandButton Command1
      Caption         =   "Show Items in Cabinet"
      Height          =   340
      Left            =   120
      TabIndex        =   5
      Top             =   2080
      Width           =   2415
   End
   Begin PictureBox FileCabinet
      AutoRedraw      =   -1  'True
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   0  'None
      Height          =   820
      Left            =   3000
      Picture         =   DLAYMAIN.FRX:0302
      ScaleHeight     =   825
      ScaleWidth      =   495
      TabIndex        =   1
      Top             =   1600
      Width           =   495
   End
   Begin PictureBox FileCabinetClosed
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   0  'None
      Height          =   820
      Left            =   3360
      Picture         =   DLAYMAIN.FRX:0604
      ScaleHeight     =   825
      ScaleWidth      =   495
      TabIndex        =   2
      Top             =   640
      Visible         =   0   'False
      Width           =   495
   End
   Begin PictureBox FileCabinetOpen
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   0  'None
      Height          =   820
      Left            =   2760
      Picture         =   DLAYMAIN.FRX:0906
      ScaleHeight     =   825
      ScaleWidth      =   495
      TabIndex        =   3
      Top             =   640
      Visible         =   0   'False
      Width           =   495
   End
   Begin CommandButton Command2
      BackColor       =   &H00E0E0E0&
      Caption         =   "Exit "
      Height          =   380
      Left            =   3000
      TabIndex        =   0
      Top             =   160
      Width           =   735
   End
   Begin ListBox FileList
      DragIcon        =   DLAYMAIN.FRX:0C08
      Height          =   1785
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   4
      Tag             =   "SourceList"
      Top             =   120
      Width           =   2415
   End
' The Delayed Drag Routine code is contained in the
' FileList_MouseMove event. The basic idea is to count
' how long the mouse is moved over a particular item (Marker)
' before dragging begins. It also checks to see whether the
' Marker is on a selected item and whether or not the cursor
' is in the listbox boundary before dragging begins.
' Since the users system clock will vary an "Adjuster" had to
' be determined to keep the delay the same for all users. I think
' it should do the trick. The API calls to determine "Showing"
' are necessary to determine the number of items that can be
' displayed in the listbox at one time. This can vary
' because of the users display. So these calls make sure we've
' got the right count.
' If you need any help, let me know and good luck!
' Jeff Simms  72200,3173
DefInt A-Z
Dim Marker As Integer
Dim OldMarker As Integer
Dim MouseTimer As Integer
Dim Showing As Integer
Dim Adjust As String
Dim LRect As RECT
Dim LBWRect As RECT
Const LEFT_BUTTON = 1
Const WM_USER = 1024
Const LB_GETITEMRECT = WM_USER + 25
Declare Function GetFocus Lib "User" () As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
Sub Command1_Click ()
  CabinetList.Show
End Sub
Sub Command2_Click ()
  End
End Sub
Sub FileCabinet_DragDrop (Source As Control, X As Single, Y As Single)
     CabinetList.List1.AddItem Source.List(Source.ListIndex)
     FileList.RemoveItem FileList.ListIndex
     FileCabinet.Picture = FileCabinetClosed.Picture
End Sub
Sub FileCabinet_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    Select Case State
    Case 0
    FileCabinet.Picture = FileCabinetOpen.Picture
    Case 1
    FileCabinet.Picture = FileCabinetClosed.Picture
    End Select
End Sub
Sub FileList_GotFocus ()
   Start! = Timer
   For L = 1 To 25000: Next L
   Finish! = Timer
   Adjuster! = (Finish! - Start!) * 9
   Adjust$ = Str$(Adjuster!)
   FlhWnd = GetFocus()
   GetWindowRect FlhWnd, LBWRect
   I = SendMessage(FlhWnd, LB_GETITEMRECT, 0, LRect)
   Y = LBWRect.bottom - LBWRect.top
   X = LRect.bottom - LRect.top
   Showing = Int(Y / X)
End Sub
Sub FileList_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button <> LEFT_BUTTON Or FileList.ListIndex = -1 Then MouseTimer = 0: Exit Sub

      OldMarker = Marker
      Marker = Int((Y / FileList.Height) * Showing) + 1
  If Marker > FileList.ListCount Then Exit Sub
  If Marker = OldMarker Then
       MouseTimer = MouseTimer + 1
  Else
       MouseTimer = 0
  End If
  If MouseTimer = Int(14 / Val(Adjust$)) + 1 And X > 0 And X < FileList.Width Then
       FileList.Drag 1
       MouseTimer = 0
  End If
End Sub
Sub Form_Load ()
    For X = 1 To 12
    Number$ = Format$(X, "00")
    FileList.AddItem "File Number " + Number$
    Next X
    FileList.ListIndex = 0
    Show
    FileList.SetFocus
End Sub